Tarea M7 S2

Librerias

library(readxl)

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(tidyverse) # manipulacion de datos

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(ggplot2) # graficos

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(magrittr) # %>%

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(dplyr)

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(rpart)

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

library(caret)

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument

Importar datos

Datos_MOD1 <- read_excel("default of credit card clients.xls")

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) : 
  attempt to use zero-length variable name

View(Datos_MOD1)

Exploración data ————

Ver la estructura de la variable y convertir a factor

names(Datos_MOD1)[which(names(Datos_MOD1) == "default payment next month")] <-"default"

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) : 
  attempt to use zero-length variable name

Datos_MOD1 %$% str(default)

 num [1:30000] 1 1 0 0 0 0 0 0 0 0 ...

Datos_MOD1 %<>% 
  mutate( default = factor(default, 
                     levels= c("1","0"), 
                     labels= c("si", "no"))) -> Datos_MOD1

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) : 
  attempt to use zero-length variable name

Datos_MOD1 %<>% 
  mutate( SEX = factor(SEX),
          EDUCATION = factor(EDUCATION),
          MARRIAGE = factor(MARRIAGE)) -> Datos_MOD1

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) : 
  attempt to use zero-length variable name

Datos_MOD1 %<>% 
  mutate( PAY_0 = factor(PAY_0), 
          PAY_2= factor(PAY_2),
          PAY_3= factor(PAY_3),
          PAY_4= factor(PAY_4),
          PAY_5= factor(PAY_5),
          PAY_6= factor(PAY_6)) -> Datos_MOD1

Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) : 
  invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) : 
  attempt to use zero-length variable name

Explorar el Balanceo

Datos_MOD1 %>%
group_by(default) %>%
  summarise( Frec= n()) %>%
  mutate(Prop= Frec/ sum(Frec) ) 

NA

Resumen de los datos

summary(Datos_MOD1)

   LIMIT_BAL       SEX       EDUCATION MARRIAGE       AGE            PAY_0           PAY_2           PAY_3      
 Min.   :  10000   1:11888   0:   14   0:   54   Min.   :21.00   0      :14737   0      :15730   0      :15764  
 1st Qu.:  50000   2:18112   1:10585   1:13659   1st Qu.:28.00   -1     : 5686   -1     : 6050   -1     : 5938  
 Median : 140000             2:14030   2:15964   Median :34.00   1      : 3688   2      : 3927   -2     : 4085  
 Mean   : 167484             3: 4917   3:  323   Mean   :35.49   -2     : 2759   -2     : 3782   2      : 3819  
 3rd Qu.: 240000             4:  123             3rd Qu.:41.00   2      : 2667   3      :  326   3      :  240  
 Max.   :1000000             5:  280             Max.   :79.00   3      :  322   4      :   99   4      :   76  
                             6:   51                             (Other):  141   (Other):   86   (Other):   78  
     PAY_4           PAY_5           PAY_6         BILL_AMT1         BILL_AMT2        BILL_AMT3         BILL_AMT4      
 0      :16455   0      :16947   0      :16286   Min.   :-165580   Min.   :-69777   Min.   :-157264   Min.   :-170000  
 -1     : 5687   -1     : 5539   -1     : 5740   1st Qu.:   3559   1st Qu.:  2985   1st Qu.:   2666   1st Qu.:   2327  
 -2     : 4348   -2     : 4546   -2     : 4895   Median :  22382   Median : 21200   Median :  20089   Median :  19052  
 2      : 3159   2      : 2626   2      : 2766   Mean   :  51223   Mean   : 49179   Mean   :  47013   Mean   :  43263  
 3      :  180   3      :  178   3      :  184   3rd Qu.:  67091   3rd Qu.: 64006   3rd Qu.:  60165   3rd Qu.:  54506  
 4      :   69   4      :   84   4      :   49   Max.   : 964511   Max.   :983931   Max.   :1664089   Max.   : 891586  
 (Other):  102   (Other):   80   (Other):   80                                                                         
   BILL_AMT5        BILL_AMT6          PAY_AMT1         PAY_AMT2          PAY_AMT3         PAY_AMT4     
 Min.   :-81334   Min.   :-339603   Min.   :     0   Min.   :      0   Min.   :     0   Min.   :     0  
 1st Qu.:  1763   1st Qu.:   1256   1st Qu.:  1000   1st Qu.:    833   1st Qu.:   390   1st Qu.:   296  
 Median : 18105   Median :  17071   Median :  2100   Median :   2009   Median :  1800   Median :  1500  
 Mean   : 40311   Mean   :  38872   Mean   :  5664   Mean   :   5921   Mean   :  5226   Mean   :  4826  
 3rd Qu.: 50191   3rd Qu.:  49198   3rd Qu.:  5006   3rd Qu.:   5000   3rd Qu.:  4505   3rd Qu.:  4013  
 Max.   :927171   Max.   : 961664   Max.   :873552   Max.   :1684259   Max.   :896040   Max.   :621000  
                                                                                                        
    PAY_AMT5           PAY_AMT6        default   
 Min.   :     0.0   Min.   :     0.0   si: 6636  
 1st Qu.:   252.5   1st Qu.:   117.8   no:23364  
 Median :  1500.0   Median :  1500.0             
 Mean   :  4799.4   Mean   :  5215.5             
 3rd Qu.:  4031.5   3rd Qu.:  4000.0             
 Max.   :426529.0   Max.   :528666.0             
                                                 

table(Datos_MOD1$SEX)

    1     2 
11888 18112 

table(Datos_MOD1$EDUCATION)

    0     1     2     3     4     5     6 
   14 10585 14030  4917   123   280    51 

table(Datos_MOD1$MARRIAGE)

    0     1     2     3 
   54 13659 15964   323 

table(Datos_MOD1$PAY_0, useNA = "ifany")

   -2    -1     0     1     2     3     4     5     6     7     8 
 2759  5686 14737  3688  2667   322    76    26    11     9    19 

table(Datos_MOD1$PAY_2, useNA = "ifany")

   -2    -1     0     1     2     3     4     5     6     7     8 
 3782  6050 15730    28  3927   326    99    25    12    20     1 

table(Datos_MOD1$PAY_3, useNA = "ifany")

   -2    -1     0     1     2     3     4     5     6     7     8 
 4085  5938 15764     4  3819   240    76    21    23    27     3 

table(Datos_MOD1$PAY_4, useNA = "ifany")

   -2    -1     0     1     2     3     4     5     6     7     8 
 4348  5687 16455     2  3159   180    69    35     5    58     2 

table(Datos_MOD1$PAY_5, useNA = "ifany")

   -2    -1     0     2     3     4     5     6     7     8 
 4546  5539 16947  2626   178    84    17     4    58     1 

table(Datos_MOD1$PAY_6, useNA = "ifany")

   -2    -1     0     2     3     4     5     6     7     8 
 4895  5740 16286  2766   184    49    13    19    46     2 

table(Datos_MOD1$default)

   si    no 
 6636 23364 

mean(Datos_MOD1$AGE)

[1] 35.4855

Visualización de Datos

# Crear un histograma para la columna "AGE" (numérica)
hist(Datos_MOD1$AGE, main = "Histograma de Edades", xlab = "Edad")

# Crear un gráfico de barras para variables categóricas (factor)
barplot(table(Datos_MOD1$SEX), main = "Distribución de Sexo")

barplot(table(Datos_MOD1$EDUCATION), main = "Distribución de Educación")

barplot(table(Datos_MOD1$MARRIAGE), main = "Distribución de Estado Civil")

NA
NA

Valores atípicos

boxplot(Datos_MOD1$LIMIT_BAL, main = "Boxplot de LIMIT_BAL")

Correlaciones

# Calcular la matriz de correlación para variables numéricas
correlation_matrix <- cor(Datos_MOD1[, c("LIMIT_BAL", "AGE", "BILL_AMT1", "BILL_AMT2", "BILL_AMT3", "BILL_AMT4", "BILL_AMT5", "BILL_AMT6", "PAY_AMT1", "PAY_AMT2", "PAY_AMT3", "PAY_AMT4", "PAY_AMT5", "PAY_AMT6")])

# Visualizar la matriz de correlación
heatmap(correlation_matrix)

NA
NA
NA

Partición Train - Test

set.seed(1234) # Semilla para aleatorios
datos_split <- Datos_MOD1 %>%
  initial_split(prop = 0.8,
                strata = default)
train <- training(datos_split)
dim(train)

[1] 23999    24

test <- testing(datos_split)
dim(test)

[1] 6001   24

Preprocesamiento

rct_data <- train %>% recipe(default ~ ., data = ., role= "predictor" ) %>%
  step_normalize( all_numeric(), -all_outcomes()) %>% # Normalizacion
  step_other(all_nominal(), -all_outcomes() ) %>% 
  step_dummy(all_nominal(), -all_outcomes() ) %>% # Dummy
  step_nzv(all_predictors()) %>% 
  themis::step_upsample(y, over_ratio = 0.9, skip= TRUE, seed= 123) %>% 
  step_sample(size = 5000, skip = TRUE, seed= 456 )

Warning: Selectors are not used for this step.

Remuestreo

set.seed(1234)
cv_data <- vfold_cv(train, v = 5, repeats = 1, strata = default)
cv_data

#  5-fold cross-validation using stratification 

Arbol de decision

# Crear el modelo de Árbol de Decisión
tree_model <- rpart(default ~ ., data = Datos_MOD1)

Grid de busqueda

# Definir la malla de búsqueda de hiperparámetros
grid <- expand.grid(cp = seq(0.01, 0.1, by = 0.01))

# Realizar la búsqueda de hiperparámetros utilizando validación cruzada
tree_model <- train(default ~ ., data = Datos_MOD1, method = "rpart", tuneGrid = grid, trControl = trainControl(method = "cv"))

# Visualizar los resultados de la búsqueda de hiperparámetros
print(tree_model)

CART 

30000 samples
   23 predictor
    2 classes: 'si', 'no' 

No pre-processing
Resampling: Cross-Validated (10 fold) 
Summary of sample sizes: 27000, 27001, 27000, 27001, 27000, 27000, ... 
Resampling results across tuning parameters:

  cp    Accuracy   Kappa    
  0.01  0.8168002  0.3343625
  0.02  0.8128335  0.3086768
  0.03  0.8128335  0.3086768
  0.04  0.8128335  0.3086768
  0.05  0.8128335  0.3086768
  0.06  0.8128335  0.3086768
  0.07  0.8128335  0.3086768
  0.08  0.8128335  0.3086768
  0.09  0.8128335  0.3086768
  0.10  0.8128335  0.3086768

Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.01.

Entrenamiento con el valor óptimo

optimal_cp <- 0.1
tree_model <- rpart(default ~ ., data = train, control = rpart.control(cp = optimal_cp))

predictions <- predict(tree_model, newdata = test, type = "class")

# Evaluación del modelo en el grupo 'test'
confusion_matrix <- table(predictions, test$default)
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)

# Visualizar la matriz de confusión
print(confusion_matrix)

           
predictions   si   no
         si  431  205
         no  897 4468

# Mostrar la precisión del modelo
print(paste("Accuracy:", accuracy))

[1] "Accuracy: 0.816363939343443"

Calcular sensibilidad

sensitivity <- confusion_matrix[2, 2] / sum(confusion_matrix[2, ])
specificity <- confusion_matrix[1, 1] / sum(confusion_matrix[1, ])
print(paste("Sensitivity:", sensitivity))

[1] "Sensitivity: 0.832805219012116"

print(paste("Specificity:", specificity))

[1] "Specificity: 0.677672955974843"

En resumen, el modelo es efectivo, ya que nos da una explicación alta a los datos que queremos encontrar mediante el uso

de árboles de decisión, optimizando sus hiperparámetros con el uso de una grid